home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / fb386 / uno / uno.bas < prev    next >
BASIC Source File  |  1991-10-18  |  49KB  |  970 lines
  1. 1 CLS:WIDTH 80,25:COLOR 7:LOCATE 0,0:GOTO 10
  2. 5 CLS:WIDTH 80,25:COLOR 7:LOCATE 0,0:GOTO 10
  3. 10 PRINT "    *********************************************************************"
  4. 13 PRINT "   ***********************************************************************"
  5. 14 PRINT "   **********                                                   **********"
  6. 15 PRINT "   *********         <<< カードゲーム『ＵＮＯ』>>>               *********"
  7. 20 PRINT "   ********                                                       ********"
  8. 25 PRINT "   *******    　　製作：幸田町立北部中学校  【科学技術部】         *******"
  9. 30 PRINT "   ******    　 　                                          　      ******"
  10. 35 PRINT "   *****        　　　　（愛知県額田郡幸田町大字高力字越丸３４）     *****"
  11. 40 PRINT "   ****                                                               ****"
  12. 45 PRINT "   ***                プログラム：只野　伸高、山本　祐輔               ***"
  13. 50 PRINT "   ****                                                               ****"
  14. 52 PRINT "   *****              　協　力  ：武藤　信行・滝本　優一             *****"
  15. 53 PRINT "   ******                                                           ******"
  16. 55 PRINT "   *******                                                         *******"
  17. 60 PRINT "   ********           　顧　問  ：廣野　守        　              ********"
  18. 65 PRINT "   *********                                                     *********"
  19. 70 PRINT "   ***********************************************************************"
  20. 75 PRINT "    ********************************************************************* "
  21. 80 PRINT:PRINT:PRINT "                          しばらくお待ち下さい．"
  22. 90 '========================= イニシャライズ・・・・・
  23. 100 '------------------------ 配列の定義など
  24. 105 CD PLAY 3,3
  25. 110 CLEAR ,,8000,1024*900:MOUSE 0:DEFINT A-Z
  26. 115 KOJIN_MAX=20:WF=0:PF=0:XS=0
  27. 130 RANDOMIZE VAL(LEFT$(TIME$,2)+MID$(TIME$,4,2))+VAL(RIGHT$(TIME$,2))
  28. 140 'ON STOP GOSUB *STOP.KEYIN:STOP ON
  29. 150 DIM CARD(108),M_CARD(4,30),SCORE(4),WAO(4),K(4),P_NAME$(4),PSUB(4),PINDX(4)
  30. 160 DIM COL(5),DISP_C$(14),CARD$(14),KAI$(39),T(20,2)
  31. 165 DIM GA%(6000),CB%(42000),CR%(42000),CG%(42000),CY%(42000),CWI%(6000)
  32. 166 DIM CTE%(6000),PL(8)
  33. 167 DIM UNO1(20000),UNO2(20000),UNO3(20000),UNO4(20000),HAKUSYU(40000),BUUING(40000)
  34. 170 '------------------------ 画面の初期設定
  35. 180 PALETTE 
  36. 181 GOSUB *BRACK:GOSUB *ONSEI
  37. 190 GOSUB *INIT.CARD:CLS:PALETTE:GOSUB *TITLE.DISP
  38. 191 MOUSE 1,0,0,1
  39. 192 PASTEL
  40. 195 FOR I=0 TO 1000:NEXT
  41. 200 '----------------------- 初期設定１
  42. 210     P_NAME$(1)="ＣＯＭ１":P_NAME$(2)="ＣＯＭ２"
  43. 220     P_NAME$(3)="ＣＯＭ３":P_NAME$(4)="ＹＯＵ！"
  44. 270     COLOR 4:LOCATE 0,22:PRINT"説明が必要ですか？　不要・左　／　必要・右"
  45. 280     IF MOUSE(2,0)<>-1 AND MOUSE(2,1)<>-1 THEN 280 ELSE 285
  46. 285     IF MOUSE(2,0)=-1 THEN BEEP 1:BEEP 0 ELSE GOSUB *SETSUMEI
  47. 290     'COL(1)=2:COL(2)=4:COL(3)=1:COL(4)=6:COL(5)=0:COL1$="RGBY*"
  48. 300     COL(1)=1:COL(2)=2:COL(3)=4:COL(4)=6:COL(5)=0:COL1$="BRGY*"
  49. 310     RESTORE 320:FOR I=1 TO 14:READ CARD$(I):NEXT I
  50. 320     DATA ０,１,２,３,４,５,６,７,８,９,Ｓ,Ｒ,Ｄ,Ｗ,WDF 
  51. 330     RESTORE *K.DATA:FOR I=0 TO 39:READ KAI$(I):NEXT
  52. 340 '------------------------ 初期設定２
  53. 350 *INIT.2
  54. 360     FOR I=1 TO 4:SCORE(I)=0:NEXT
  55. 370     PLAYER=4:ROUND=0:TAKO=INT(RND*4)
  56. 380     GOTO *INIT.3
  57. 450 '------------------------ 解説のデータ
  58. 460 *K.DATA
  59. 470     DATA 難しい所ですね ,逆襲が恐いねえ ,説明のしようもないですねえ
  60. 475     DATA いやあ、どうでしょうねえ？
  61. 480     DATA わて賢ないからわからへん,不吉じゃのう！！！
  62. 485     DATA この人、天才じゃ！！　　,おっ、恐ろしい・・
  63. 490     DATA なんなんだよ～ ,すこ～～～ん！ ,だめだ、こりゃ ,痛ったいなあ
  64. 500     DATA 悲惨だ。まいった、まいった ,なんとあさはかな
  65. 505     DATA あっははは・・,まあ、いいじゃないの
  66. 510     DATA えっとー、うんむう,ブラボー！！　,ばちがあたるよ　,知りませんよ
  67. 520     DATA これがさだめじゃ,知るかってーの！！
  68. 525     DATA おー！ビューティフル,この世の終わりじゃ
  69. 530     DATA ガガガチョ～ン ,疑問を感じますねえ,いやあやんなった,おぉっ！？ん？
  70. 540     DATA ばちあたりもんがあ,よくできました
  71. 545     DATA 荒業に持っていった,個人的には嫌だね
  72. 550     DATA おじさんはまいりました,市場最悪のケースだぜ！
  73. 555     DATA ベストだぜっ！,燃えてますなあ
  74. 560     DATA こりゃまたどっこい,ヌオー頭いてー！
  75. 565     DATA タワケこのやろー！,そんなーあ
  76. 760 '------------------------ ゲームの説明画面
  77. 770 *SETSUMEI
  78. 780     WIDTH 80:COLOR 7:CLS 
  79. 830     LOCATE 1,1:PRINT"* プレーヤー４人のうち３人をComputerが受け持ちます。"
  80. 840     LOCATE 1,3:PRINT"* 早く ";:COLOR 5:PRINT"５００点取った人の勝ち";
  81. 850     COLOR 7:PRINT"です。（ここでのルール）"
  82. 870     LOCATE 1,5:PRINT"* 「ＵＮＯ」の宣言を忘れると２枚取るという罰があります。"
  83. 875     PRINT ""
  84. 880     LOCATE 1,7:PRINT"* このゲームでは、";:COLOR 5:PRINT"誰か一人でも持っているカードが２０枚越えたときか、":PRINT "   山のカードを全部使いきって引くカードが無くなったときには、流れになります。":COLOR 7
  85. 890     LOCATE 1,10:PRINT"* カードを出すときは";:COLOR 5:PRINT "マウスの左をクリック";:COLOR 7:PRINT "してください．"
  86. 900     LOCATE 1,12:PRINT"* 出せるカードのないときは，";:COLOR 5:PRINT "山のカードの所にマウスカーソルをもっていき"
  87. 905     LOCATE 2,13:PRINT " 左をクリックしてください．":COLOR 7
  88. 910     LOCATE 1,15:PRINT"* WILD, WILD DRAW FOURを出したら，何色（青，赤，黄，緑）にするか聞くので"
  89. 915     LOCATE 2,16:PRINT" 変えたい色を中から選んでください．"
  90. 925     LOCATE 1,18:PRINT"* ゲーム中に出てくるメッセージも，何かの参考にしてください．"
  91. 930     COLOR 6:LOCATE 24,20:PRINT"マウスの左をクリックしてください．"
  92. 940     R=RND:IF MOUSE(2,0)=0 THEN 940
  93. 950     CLS:COLOR 2
  94. 960     LOCATE 26,1:PRINT "カードの説明":COLOR 5
  95. 970     LOCATE 1,3:PRINT "* ０～９・・・";:COLOR 7:PRINT "数字のカードです．"
  96. 980     COLOR 5:LOCATE 3,4:PRINT "色が同じか，数字が同じ";:COLOR 7:PRINT "で出すことができます．":COLOR 5
  97. 990     LOCATE 1,6:PRINT "* ＤＲＡＷ  ＴＷＯ・・・";:COLOR 7:PRINT "自分が出すと次の番の敵に";:COLOR 5:PRINT "２枚取らせる";:COLOR 7:PRINT "ことができます．"
  98. 1000    LOCATE 3,7:PRINT"自分がくらうと";:COLOR 5:PRINT "２枚取る";:COLOR 7:PRINT "ことになり，自分の番はなくなります．":COLOR 5
  99. 1010    LOCATE 1,9:PRINT"* ＳＫＩＰ・・・";:COLOR 7:PRINT "出すと，";:COLOR 5:PRINT "次の番の敵を飛ばす";:COLOR 7:PRINT "ことができます．":COLOR 5
  100. 1020    LOCATE 1,11:PRINT "* ＲＥＶＥＲＳＥ・・・回る方向を逆";:COLOR 7:PRINT "にできます．":COLOR 5
  101. 1030    LOCATE 1,13:PRINT "* ＷＩＬＤ・・・色を変える";:COLOR 7:PRINT "ことができます．"
  102. 1040    LOCATE 3,14:PRINT "普通は，出せるカードのないときに出します．":COLOR 5
  103. 1050    LOCATE 1,16:PRINT "* ＷＩＬＤ ＤＲＡＷＦＯＵＲ・・・";:COLOR 7:PRINT"ＷＩＬＤと同じように";:COLOR 5:PRINT"色を変える";:COLOR 7:PRINT "ことができます．"
  104. 1060    LOCATE 3,17:PRINT "そして次の番の敵に，";:COLOR 5:PRINT "４枚取らせる";:COLOR 7:PRINT "ことができます．"
  105. 1070    LOCATE 3,18:PRINT "但し”チャレンジ”され成功すると，自分が";:COLOR 5:PRINT"４枚取る";:COLOR 7:PRINT "ことになります．"
  106. 1080    LOCATE 1,20:PRINT "* 自分が”チャレンジ”し成功すると出した敵に";:COLOR 5:PRINT "４枚取らせる";:COLOR 7:PRINT "ことができ"
  107. 1090    LOCATE 3,21:PRINT "失敗すると，自分が";:COLOR 5:PRINT "６枚取る";:COLOR 7:PRINT "ことになります．"
  108. 1100    COLOR 6:LOCATE 24,22:PRINT "マウスの左をクリックしてください．"
  109. 1110    R=RND:IF MOUSE(2,0)=0 THEN 1110
  110. 1120 CLS:RETURN
  111. 1130 '----------------------- 初期設定３／中間報告
  112. 1140 *INIT.3
  113. 1280 '---------------------------カ－ドを，シャッフルする
  114. 1285    FOR I=1 TO 4:K(I)=7:NEXT:REVERSE=1
  115. 1290    ERASE CARD:DIM CARD(108)
  116. 1300    FOR I=0 TO 12
  117. 1303      FOR C=1 TO 4
  118. 1305        FOR J=1 TO 1-(I>0)
  119. 1310          X=INT(RND(1)*108)+1:IF CARD(X)<>0 THEN 1310
  120. 1320          CARD(X)=C*100+I
  121. 1330        NEXT
  122. 1333      NEXT
  123. 1335    NEXT
  124. 1340    FOR J=1 TO 4
  125. 1345      FOR I=13 TO 14
  126. 1350        FOR X=1 TO 108
  127. 1355          IF CARD(X)=0 THEN 1370
  128. 1360        NEXT
  129. 1370        CARD(X)=500+I
  130. 1380        XS=INT(RND(1)*108)+1
  131. 1385        IF XS=X OR CARD(XS)=0 THEN 1380
  132. 1390        SWAP CARD(X),CARD(XS)
  133. 1400      NEXT I
  134. 1405    NEXT J
  135. 1410 '----------------------- カードを配る
  136. 1420    FOR I=1 TO KOJIN_MAX:FOR J=1 TO 4:M_CARD(J,I)=0:NEXT:NEXT
  137. 1430    D_POINT=1
  138. 1440    FOR I=1 TO 7:FOR J=1 TO 4:M_CARD(J,I)=CARD(D_POINT):D_POINT=D_POINT+1:NEXT:NEXT
  139. 1450    CARD=D_POINT:GOSUB *CARD.FNC:IF CARD_N=11 THEN GOSUB 1520:GOTO 1470
  140. 1460    IF CARD_N>12 THEN 1490
  141. 1470    BA_N=CARD_N:BA_C=CARD_C:D_POINT=D_POINT+1:P_POINT=1
  142. 1480    GOTO *MAIN1
  143. 1485    '
  144. 1490    C1=CARD:FOR CARD=30 TO 108:GOSUB *CARD.FNC:IF CARD_N<13 THEN 1510
  145. 1500    NEXT
  146. 1510    SWAP CARD(C1),CARD(CARD):CARD=C1:GOSUB *CARD.FNC:GOTO 1470
  147. 1520    PLAYER=PLAYER+1:IF PLAYER>4 THEN PLAYER=1
  148. 1530 RETURN
  149. 1540 '----------------------- カードの種類を調べる
  150. 1550 *CARD.FNC
  151. 1560    CARD_C=CARD(CARD)\100:CARD_N=CARD(CARD)MOD 100:RETURN
  152. 1660 '----------------------- ＳＴＯＰキー入力
  153. 1670 *STOP.KEYIN
  154. 1680    SENTAKU1$="終了しますか？":SENTAKU2$="ＹＥＳ　 ＮＯ":GOSUB *SENTAKU:'BEEP 1:STOP OFF:COLOR 7:SCREEN,3:WIDTH 80:BEEP 0
  155. 1681    IF SEN=1 THEN 1690
  156. 1682    IF SEN=2 THEN RETURN
  157. 1690    PRINT"* プログラムを終了します　！！":PRINT:PRINT
  158. 1700 END
  159. 1710 '----------------------- ＭＡＩＮルーチン１
  160. 1720 *MAIN1:
  161. 1730    GOSUB *MAKE.S
  162. 1830    PL=PLAYER
  163. 1840    FOR I=1 TO 3:FOR J=1 TO 7:CPUT_X=J*40:CPUT_Y=(I-1)*82+15
  164. 1850      PLAYER=I:CARD_P=0:GOSUB *CARD.DISP
  165. 1860    NEXT J,I
  166. 1865    PLAYER=4
  167. 1870    FOR J=1 TO 7
  168. 1875      CPUT_X=(J-1)*64+40:CPUT_Y=282:CARD_P=-1
  169. 1877      CARD=M_CARD(4,J):GOSUB *CARD.FNC2:GOSUB *CARD.DISP
  170. 1879    NEXT J
  171. 1880    GOSUB *CARD.DRAW:PLAYER=PL
  172. 1960    S=BA_N:GOSUB *H.SEARCH
  173. 2030 '----------------------- ＭＡＩＮルーチン・ループ
  174. 2050 *MAIN
  175. 2055    CDSTAT PL:IF PL(1)=0 THEN CD PLAY 3,3 
  176. 2060    '-------------------- ＵＮＯになったときの処置
  177. 2065    IF PLAYER=4 AND WAO(PLAYER)=-1 THEN 2080
  178. 2070    IF K(PLAYER)=1 AND RND(1)<.9! AND WAO(PLAYER)=0 THEN WAO(PLAYER)=-1:BEEP 1:GOTO 2072:ELSE WAO(PLAYER)=0:GOTO 2080
  179. 2072      IF PLAYER=1 THEN PCMPLAY UNO1,127
  180. 2073      IF PLAYER=2 THEN PCMPLAY UNO2,127
  181. 2074      IF PLAYER=3 THEN PCMPLAY UNO3,127
  182. 2075      IF PLAYER=4 THEN PCMPLAY UNO4,127
  183. 2076    BEEP 0
  184. 2080    '
  185. 2084    IF K(PLAYER)=1 AND WAO(PLAYER)=0 THEN GOSUB *UNO.BATU:WAO(PLAYER)=0
  186. 2090    '-------------------- 回る方向を表示する
  187. 2100    GOSUB *SIKAKU.KESU
  188. 2110    PLAYER=PLAYER+REVERSE
  189. 2120    IF PLAYER>4 THEN PLAYER=1
  190. 2123    IF PLAYER<1 THEN PLAYER=4
  191. 2125    GOSUB *SIKAKU.KAKU
  192. 2150    IF HAPPEN THEN *HAPPENNING
  193. 2160    IF PLAYER<4 THEN *COM.THINK
  194. 2170    GOTO *MAN
  195. 2180 '----------------------- あがり
  196. 2190 *AGARI
  197. 2200    IF BA_N=14 THEN MAI=4:GOTO 2220 ELSE IF BA_N=12 THEN MAI=2:GOTO 2220
  198. 2210    GOTO 2250
  199. 2220    PLAYER1=PLAYER:PLAYER=PLAYER+REVERSE
  200. 2230    IF PLAYER>4 THEN PLAYER=1 ELSE IF PLAYER<1 THEN PLAYER=4
  201. 2240    GOSUB *ERASE.LINE
  202. 2243    PRINT "｢";P_NAME$(PLAYER); "｣さん";MAI;"枚ひいて下さい。";
  203. 2245    IF PLAYER1=4 THEN CARD_P=0
  204. 2248    GOSUB 4450:GOSUB *CARD.DRAW:PLAYER=PLAYER1
  205. 2250    COLOR=(3,2):BEEP:COLOR=(3,6):BEEP:COLOR=(3,1):BEEP:COLOR 7
  206. 2260    GOSUB *ERASE.LINE:PRINT"｢";P_NAME$(AGARI_P);"｣があがりました！！";
  207. 2265    IF AGARI_P=4 THEN PCMPLAY HAKUSYU,127 ELSE PCMPLAY BUUING,127
  208. 2270    FOR LP=1 TO 100:COLOR=(0,INT(RND*7)+1):BEEP 1:BEEP 0:NEXT
  209. 2280    COLOR=(0,3):COLOR=(3,4)
  210. 2290    FOR LP=1 TO 2700:NEXT:BEEP
  211. 2300    TOTAL=0:AG_PLAYER=AGARI_P
  212. 2310    FOR PLAYER=1 TO 4
  213. 2315      IF PLAYER=AG_PLAYER THEN SC=0:GOTO 2400
  214. 2320      'CHA=-1:GOSUB *CARD.DRAW:CHA=0
  215. 2330      SC=0
  216. 2335      FOR LP=1 TO KOJIN_MAX
  217. 2337        IF M_CARD(PLAYER,LP)=0 THEN 2370
  218. 2340        CARD_N=M_CARD(PLAYER,LP)MOD 100:IF CARD_N>12 THEN SC=SC+50
  219. 2350        IF CARD_N>9 AND CARD_N<13 THEN SC=SC+20
  220. 2360        IF CARD_N<10 THEN SC=SC+CARD_N
  221. 2370      NEXT
  222. 2380      GOSUB *ERASE.LINE:PRINT"｢";P_NAME$(PLAYER);"｣のカードの合計点は、";SC; "点です。";:SCORE(PLAYER)=SCORE(PLAYER)-SC
  223. 2390      FOR LP=1 TO 2700:NEXT
  224. 2400      TOTAL=TOTAL+SC
  225. 2405    NEXT
  226. 2410    COLOR 5:LOCATE 6,(AG_PLAYER-1)*4+1+(AG_PLAYER=3):PRINT"<------------------- あがり！！"
  227. 2420    LOCATE 6,(AG_PLAYER-1)*4+2:PRINT"得点　：　";TOTAL;"点"
  228. 2430    SCORE(AG_PLAYER)=SCORE(AG_PLAYER)+TOTAL:COLOR=(0,0):COLOR=(2,2):COLOR=(3,3)
  229. 2440    IF SCORE(AG_PLAYER)>=500 THEN *GAME.SET
  230. 2450    FOR LP=1 TO 10000:NEXT
  231. 2460    PLAYER=AG_PLAYER
  232. 2470    TAKO=INT(RND*4):IF TAKO=AG_PLAYER THEN TAKO=0
  233. 2480 GOTO *INIT.3
  234. 2490 '----------------------- ゲームセット
  235. 2500 *GAME.SET
  236. 2510    GOSUB *ERASE.LINE:COLOR 6:PRINT "＊＊＊＊＊ ｢";P_NAME$(AG_PLAYER);"｣が５００点を越えました！";:BEEP
  237. 2515    FOR I=1 TO 5000:NEXT
  238. 2520    CLS:LINE(0,0)-(639,479),PSET,1,BF
  239. 2530    SYMBOL (224,60),"＊＊＊＊　総合結果　＊＊＊＊",1,1,5,,,1:'28,3
  240. 2540    FOR I=1 TO 4:PINDX(I)=I:PSUB(I)=SCORE(I):NEXT I
  241. 2545    FOR J=3 TO 1 STEP -1
  242. 2550      FOR I=1 TO J
  243. 2560        IF PSUB(I)<PSUB(I+1) THEN SWAP PSUB(I),PSUB(I+1):SWAP PINDX(I),PINDX(I+1)
  244. 2565      NEXT I
  245. 2570    NEXT J
  246. 2580    LINE( 0, 0)-(639,479),PSET,7,B:LINE( 1, 1)-(638,478),PSET,7,B
  247. 2590    LINE(10,10)-(629,469),PSET,7,B:LINE(11,11)-(628,468),PSET,7,B
  248. 2600    LINE(20,20)-(619,459),PSET,7,B:LINE(21,21)-(618,458),PSET,7,B
  249. 2605    SYMBOL (184,100),"優勝・・・"+P_NAME$(PINDX(1))+"　　：　得点"+AKCNV$(RIGHT$("   "+STR$(SCORE(PINDX(1))),4))+"点",1,1,7,,,1
  250. 2610    SYMBOL (184,140),"２位・・・"+P_NAME$(PINDX(2))+"　　：　得点"+AKCNV$(RIGHT$("   "+STR$(SCORE(PINDX(2))),4))+"点",1,1,7,,,1
  251. 2620    SYMBOL (184,160),"３位・・・"+P_NAME$(PINDX(3))+"　　：　得点"+AKCNV$(RIGHT$("   "+STR$(SCORE(PINDX(3))),4))+"点",1,1,7,,,1
  252. 2630    SYMBOL (184,180),"４位・・・"+P_NAME$(PINDX(4))+"　　：　得点"+AKCNV$(RIGHT$("   "+STR$(SCORE(PINDX(4))),4))+"点",1,1,7,,,1
  253. 2700    SENTAKU1$="もう一度やりますか？":SENTAKU2$="ＹＥＳ　 ＮＯ"
  254. 2705    SX=140:SY=260:GOSUB *SENTAKU2
  255. 2710    IF SEN=1 THEN BEEP:GOTO *INIT.2
  256. 2720    COLOR=(0,0):COLOR 7:END
  257. 2840 '----------------------- 人間の入力
  258. 2850 *MAN
  259. 2880    GOSUB *INPUT_CARD2:IF TAKE=0 THEN *GET_CARD
  260. 2890    GOSUB *CAN_PUT:IF CAN THEN GOSUB *PUT_CARD:GOTO *NEXT.P ELSE 2880
  261. 3080 '----------------------- カードを出す
  262. 3090 *PUT_CARD
  263. 3100    SITA_C=BA_C:SITA_N=BA_N:CARD=P_POINT:CARD(P_POINT)=M_CARD(PLAYER,CAN)
  264. 3105    M_CARD(PLAYER,CAN)=0:P_POINT=P_POINT+1
  265. 3110    GOSUB *CARD.FNC:S=CARD_N:GOSUB *H.SEARCH
  266. 3120    BA_C=CARD_C:BA_N=CARD_N:BA_P=PLAYER:BA_X=P_POINT:K(PLAYER)=K(PLAYER)-1
  267. 3130    IF WAO(PLAYER) THEN *NEXT.P
  268. 3140    KAI=INT(RND*40):COLOR 7:LOCATE 19,11:PRINT SPC(59)
  269. 3145    LOCATE 19,11:COLOR 4:PRINT KAI$(KAI)
  270. 3147 RETURN
  271. 3150 '----------------------- 一人分の処理終了
  272. 3160 *NEXT.P
  273. 3170    GOSUB *CARD.SORT:GOSUB *CARD.DRAW:GET_C=0
  274. 3173    IF K(4)<>1   THEN 3178
  275. 3175    IF WAO(4)=-1 THEN 3178 ELSE GOSUB *UNO.BATU
  276. 3178    IF K(PLAYER)=0 THEN AGARI_P=PLAYER   :GOTO *AGARI
  277. 3180    GOTO *MAIN
  278. 3190 '----------------------- メッセージ表示部の消去
  279. 3200 *ERASE.LINE
  280. 3205    LOCATE 19,11:PRINT SPC(59):LOCATE 19,11
  281. 3210 RETURN
  282. 3220 '----------------------- カードを出せるかどうか
  283. 3230 *CAN_PUT
  284. 3240    IF M_CARD(PLAYER,TAKE)\100   =BA_C THEN CAN=TAKE:GOTO 3275
  285. 3250    IF M_CARD(PLAYER,TAKE)MOD 100=BA_N THEN CAN=TAKE:GOTO 3275
  286. 3260    IF M_CARD(PLAYER,TAKE)MOD 100>12   THEN CAN=TAKE:GOTO 3275
  287. 3270    CAN=0
  288. 3275 RETURN
  289. 3280 '----------------------- 人間が１枚ひく
  290. 3290 *GET_CARD
  291. 3300    FOR X=1 TO KOJIN_MAX:PF=0
  292. 3305      IF M_CARD(PLAYER,X)=0 THEN PF=-1:XS=X:X=KOJIN_MAX:'3320
  293. 3310    NEXT
  294. 3311    IF PF=-1 THEN PF=0:X=XS:GOTO 3320
  295. 3315    GOTO *NAGARE
  296. 3320    COLOR 7:LOCATE 58,4:PRINT "残り":LOCATE 66,4:PRINT "枚"
  297. 3325    M_CARD(PLAYER,X)=CARD(D_POINT):D_POINT=D_POINT+1:COLOR 7:LOCATE 62,4:PRINT USING"####";109-D_POINT:IF D_POINT>108 THEN *OVER.108
  298. 3330    FOR GC=1 TO 3:BEEP 1:BEEP 0:FOR GC0=1 TO 50:NEXT:NEXT
  299. 3340    K(PLAYER)=K(PLAYER)+1
  300. 3350    CARD=D_POINT-1:GOSUB *CARD.FNC
  301. 3355    IF PLAYER=4 THEN CPUT_X=560:CPUT_Y=143:ELSE CPUT_X=565:CPUT_Y=176
  302. 3360    CARD_P=-1:GOSUB *CARD.DISP
  303. 3370    IF CARD_C=BA_C OR CARD_N=BA_N OR CARD_N>12 THEN 3380 ELSE 3395
  304. 3380    GOSUB *ERASE.LINE:PRINT"山のところに表示されたのがめくったカードです。"
  305. 3382    SENTAKU1$="カードを出しますか？":SENTAKU2$="ＹＥＳ　 ＮＯ"
  306. 3383    GOSUB *SENTAKU
  307. 3390    IF SEN=1 THEN GET_C=-1:CAN=X:GOSUB *DRAW.KESU:GOSUB *PUT_CARD:GOTO *NEXT.P
  308. 3395    FOR LP=1 TO 1000:NEXT LP:    GOSUB *DRAW.KESU:GOTO *NEXT.P
  309. 3400 '----------------------- ひいたカードを消して元に戻す
  310. 3403 *DRAW.KESU:
  311. 3405    IF PLAYER=4 THEN LINE(560,143)-(624,243),PSET,0,BF:CPUT_X=565:CPUT_Y=176:CARD_P=0:GOSUB *CARD.DISP
  312. 3406    IF K(4)<>1 THEN LINE(595,270)-(619,381),PSET,0,BF
  313. 3407 RETURN
  314. 3410 '----------------------- カードの１人分の表示、及び場のカードの表示
  315. 3420 *CARD.DRAW
  316. 3430    IF WF=-1 THEN CARD_C=5:CARD_P=-1 ELSE CARD_P=-1:CARD_C=BA_C:CARD_N=BA_N
  317. 3435    CPUT_X=480:CPUT_Y=143:GOSUB *CARD.DISP
  318. 3440    IF WF=-1 THEN CARD_C=TK_C:WF=0
  319. 3450    CARD_P=0
  320. 3460    CPUT_X=565:CPUT_Y=176:GOSUB *CARD.DISP
  321. 3461    ON CARD_C GOTO 3462,3463,3464,3465
  322. 3462      COLOR 1:LOCATE 62,5:PRINT "青色":COLOR 7:BA_C=1:GOTO 3470
  323. 3463      COLOR 2:LOCATE 62,5:PRINT "赤色":COLOR 7:BA_C=2:GOTO 3470
  324. 3464      COLOR 4:LOCATE 62,5:PRINT "緑色":COLOR 7:BA_C=3:GOTO 3470
  325. 3465      COLOR 6:LOCATE 62,5:PRINT "黄色":COLOR 7:BA_C=4:GOTO 3470
  326. 3470    IF GET_C  THEN RETURN
  327. 3480    IF CHA=-1 THEN CARD_P=-1
  328. 3490    IF PLAYER=4 THEN CARD_P=-1:X0PU=0:GOSUB *CARD.SORT:ELSE 3510
  329. 3500      IF K(4)=>8 THEN HA=INT(448/K(4)):HA1=HA ELSE HA=64:HA1=HA
  330. 3502      HX=40:LINE(37,282)-(550,382),PSET,0,BF:GOSUB *CARD.DRAW2:GOTO 3516
  331. 3505      '-----------------
  332. 3510      CARD_P=0:IF K(PLAYER)=>8 THEN HA=INT(280/K(PLAYER)) ELSE HA=40
  333. 3512      HX=40:LINE(40,15+(PLAYER-1)*82)-(380,15+(PLAYER-1)*82+64),PSET,0,BF
  334. 3514      GOSUB *CARD.DRAW2
  335. 3516 RETURN
  336. 3518 '----------------------
  337. 3520 *CARD.DRAW2
  338. 3525    K=0:PF=0
  339. 3528    FOR CARD=1 TO KOJIN_MAX
  340. 3530      IF M_CARD(PLAYER,CARD)=0 THEN 3580
  341. 3540      CARD_C=M_CARD(PLAYER,CARD)\100
  342. 3545      CARD_N=M_CARD(PLAYER,CARD)-CARD_C*100
  343. 3550      CPUT_X=40+HA*(CARD-1)
  344. 3553      CPUT_Y=((PLAYER=4)*267+(PLAYER<>4)*(PLAYER-1)*82-15)*-1
  345. 3555      IF PLAYER=4 THEN CARD_P=-1 ELSE CARD_P=0
  346. 3560      GOSUB *CARD.DISP
  347. 3570      K=K+1:IF K=K(PLAYER) THEN PF=-1:XS=CARD:CARD=KOJIN_MAX
  348. 3580    NEXT
  349. 3585    IF PF=-1 THEN PF=0:CARD=XS
  350. 3590 RETURN
  351. 3690 '----------------------- WDF / W / D / R / S のカードを出したときの処理
  352. 3700 *H.SEARCH
  353. 3710    HAPPEN=0
  354. 3715    IF S<10 THEN GOTO 3765
  355. 3720    IF S=10 THEN HAPPEN=3                   :GOTO 3765
  356. 3730    IF S=11 THEN HAPPEN=4:REVERSE=REVERSE*-1:GOTO 3765
  357. 3740    IF S=12 THEN HAPPEN=2                   :GOTO 3765
  358. 3750    IF S=13 THEN GOSUB *H.SEARCH2           :GOTO 3765
  359. 3760    HAPPEN=1:GOSUB *H.SEARCH2
  360. 3765 RETURN
  361. 3770 *H.SEARCH2
  362. 3775    IF WAO(PLAYER) AND K(PLAYER)=1 THEN 3840
  363. 3780    GOSUB *ERASE.LINE:WF=-1:IF PLAYER<4 THEN 3830
  364. 3790    GOSUB *WILD.CO:GOTO 3840:
  365. 3830    PRINT P_NAME$(PLAYER);" : ";CARD$(S);" !  色を ｢";AKCNV$(MID$(COL1$,TK_C,1));"｣ にする！";:FOR LP=1 TO 2700:NEXT
  366. 3831    ON TK_C GOTO 3832,3833,3834,3835
  367. 3832      COLOR 1:LOCATE 62,5:PRINT "青色":COLOR 7:BA_C=1:GOTO 3840
  368. 3833      COLOR 2:LOCATE 62,5:PRINT "赤色":COLOR 7:BA_C=2:GOTO 3840
  369. 3834      COLOR 4:LOCATE 62,5:PRINT "緑色":COLOR 7:BA_C=4:GOTO 3840
  370. 3835      COLOR 6:LOCATE 62,5:PRINT "黄色":COLOR 7:BA_C=6:GOTO 3840
  371. 3840 RETURN
  372. 3850 '----------------------- WDF / D / R / S 処理の分岐
  373. 3860 *HAPPENNING
  374. 3880    HAP=HAPPEN:HAPPEN=0:ON HAP GOTO *WDF,*TDRAW,*SKIP,*REVERSE
  375. 3890 '----------------------- DRAW TWO の処理
  376. 3900 *TDRAW
  377. 3910    GOSUB *ERASE.LINE:IF PLAYER=4 THEN 3930
  378. 3920    PRINT "ＣＭ";AKCNV$(RIGHT$(STR$(PLAYER),1));
  379. 3925    PRINT "さんはカードを２枚取ります。";:GOTO 3940
  380. 3930    PRINT "ＹＯＵには、カードを２枚取ってもらいます。";
  381. 3940    FOR LP=1 TO 1000:NEXT:MAI=2:GOSUB *TDRAW.CARD
  382. 3950    GOSUB *ERASE.LINE:IF PLAYER<4 THEN PRINT"あ－あ・・・・";
  383. 3960    GOTO *NEXT.P
  384. 3970 '----------------------- SKIP の処理
  385. 3980 *SKIP
  386. 3990    GOSUB *ERASE.LINE:IF PLAYER=4 THEN 4010
  387. 4000    PRINT "ＣＭ";AKCNV$(RIGHT$(STR$(PLAYER),1));
  388. 4005    PRINT "さんはＳＫＩＰされました。";:GOTO 4020
  389. 4010    PRINT "ＹＯＵは、ＳＫＩＰされました。";
  390. 4020    FOR LP=1 TO 2700:NEXT:GOSUB *ERASE.LINE:GOTO *MAIN
  391. 4030 '----------------------- REVERSE の処理
  392. 4040 *REVERSE
  393. 4050    GOSUB *ERASE.LINE:PRINT"ＲＥＶＥＲＳＥが出たので、回り方が";
  394. 4060    IF REVERSE=1 THEN PRINT"上から下"; ELSE PRINT"下から上";
  395. 4070    PRINT"となります";:FOR LP=1 TO 2700:NEXT:GOTO 2160
  396. 4080 '----------------------- WILD DRAW FOUR の処理
  397. 4090 *WDF
  398. 4100    GOSUB *ERASE.LINE:IF PLAYER<4 THEN *COM.WDF
  399. 4110   'PRINT P.NAME$(4);"は、チャレンジをしますか？ : ";
  400. 4113    SENTAKU1$="チャレンジしますか？":SENTAKU2$="ＹＥＳ　 ＮＯ"
  401. 4115    GOSUB *SENTAKU
  402. 4120    IF SEN=1 THEN 4160
  403. 4130    GOSUB *ERASE.LINE:PRINT P_NAME$(4);"は、カードを４枚取ってもらいます！"
  404. 4140    FOR LP=1 TO 1000:NEXT
  405. 4150    MAI=4:GOSUB *TDRAW.CARD:GOTO *NEXT.P
  406. 4160    PLAYER1=PLAYER:PLAYER=BA_P
  407. 4170    PLAYER=PLAYER1:CHA=0
  408. 4180    DF_PLAYER=BA_P
  409. 4190    CHARENGE=0:PF=0
  410. 4193    FOR X=1 TO KOJIN_MAX
  411. 4195      IF M_CARD(DF_PLAYER,X)\100=SITA_C THEN PF=-1:CHARENGE=-1:XS=X:PUT_X=X:X=KOJIN_MAX
  412. 4200    NEXT
  413. 4205    IF PF=-1 THEN PF=0:X=XS
  414. 4210    FOR LP=1 TO 2700:NEXT
  415. 4215    GOSUB *ERASE.LINE:COLOR 7:IF CHARENGE THEN 4230
  416. 4220    PRINT"チャレンジ失敗！";:BEEP:MAI=6:GOSUB *TDRAW.CARD:GOTO *NEXT.P
  417. 4230    PRINT"チャレンジ成功！";:BEEP:MAI=4:PLAYER=DF_PLAYER
  418. 4240    PF=0:FOR X=1 TO KOJIN_MAX:IF M_CARD(PLAYER,X)=0 THEN PF=-1:XS=X:X=KOJIN_MAX:'4260
  419. 4250    NEXT:IF PF=-1 THEN PF=0:X=XS:GOTO 4260:'GOTO *NAGARE
  420. 4255    GOTO *NAGARE
  421. 4260    M_CARD(PLAYER,X)=514:K(PLAYER)=K(PLAYER)+1:P_POINT=P_POINT-1:BA_C=SITA_C:BA_N=SITA_N:IF PLAYER<4 THEN GOSUB *POOR.COM ELSE GOSUB *POOR.MAN
  422. 4270    GOSUB *TDRAW.CARD:GOTO *NEXT.P
  423. 4275 '-----------------------
  424. 4280 *POOR.MAN
  425. 4290    FOR X=PUT_X TO KOJIN_MAX
  426. 4295     IF NOT M_CARD(PLAYER,X)\100=BA_C THEN 4310
  427. 4300     GOSUB *ERASE.LINE:COLOR COL(BA_C):PRINT"※";:COLOR 7
  428. 4305     PRINT MID$(COL1$,BA_C,1);"の";AKCNV$(CARD$(M_CARD(PLAYER,X)MOD 100));
  429. 4307     PRINT "を出していいですか？ (Y/N) : ";
  430. 4308     SENTAKU1$="出してもいい":SENTAKU2$="ＹＥＳ    ＮＯ"
  431. 4309     PF=0:IF SEN=1 THEN PF=-1:XS=X:X=KOJIN_MAX:'4340
  432. 4310   NEXT
  433. 4315  IF PF=-1 THEN PF=0:X=XS:GOTO 4340 ELSE 4290
  434. 4318 '-----------------------
  435. 4320 *POOR.COM
  436. 4330    X=PUT_X
  437. 4340    SITA_C=BA_C:SITA_N=BA_N:CARD=P_POINT
  438. 4345    CARD(P_POINT)=M_CARD(PLAYER,X):M_CARD(PLAYER,X)=0:P_POINT=P_POINT+1
  439. 4350    GOSUB *CARD.FNC:S=CARD_N:GOSUB *H.SEARCH:BA_C=CARD_C:BA_N=CARD_N
  440. 4355    BA_P=PLAYER:BA_X=P_POINT:K(PLAYER)=K(PLAYER)-1:GET_C=0
  441. 4358 RETURN
  442. 4360    GOSUB *H.SEARCH:BEEP 1:BA_C=CARD_C:BA_N=CARD_N:BA_P=PLAYER
  443. 4370    K(PLAYER)=K(PLAYER)-1:K1(PLAYER,CARD_C)=K1(PLAYER,CARD_C)-1:BEEP 0
  444. 4380 *COM.WDF
  445. 4390    IF WAO(PLAYER) THEN 4410
  446. 4400    IF K(BA_P)>=10 OR RND<.5! OR PLAYER=TAKO THEN GOSUB *ERASE.LINE:PRINT P_NAME$(PLAYER);" : チャレンジだ！！";:GOTO 4180
  447. 4410    PRINT P_NAME$(PLAYER);" : ちぇっ！しゃあない。４枚もらうとするか・・・。";:GOTO 4140
  448. 4420 '----------------------- カードをひくＳＵＢルーチン
  449. 4430 *TDRAW.CARD
  450. 4440    CARD_P=0:IF PLAYER=4 THEN CARD_P=-1
  451. 4450    FOR LP=1 TO MAI:PF=0
  452. 4460      FOR X=1 TO KOJIN_MAX:PF=0
  453. 4465        IF M_CARD(PLAYER,X)=0 THEN XS=X:X=KOJIN_MAX:PF=-1
  454. 4470      NEXT X
  455. 4475      IF PF=-1 THEN PF=0:X=XS:GOTO 4480 ELSE X=XS:PF=-2:LP=MAI:GOTO 4633
  456. 4480      COLOR 7:LOCATE 58,4:PRINT "残り":LOCATE 66,4:PRINT "枚"
  457. 4485      M_CARD(PLAYER,X)=CARD(D_POINT):D_POINT=D_POINT+1:COLOR 7
  458. 4487      LOCATE 62,4:PRINT USING"####";109-D_POINT
  459. 4489      IF D_POINT>108 THEN PF=-3:LP=MAI:GOTO 4633
  460. 4500      K(PLAYER)=K(PLAYER)+1
  461. 4510      CARD=D_POINT-1:GOSUB *CARD.FNC:C=CARD_C:N=CARD_N
  462. 4515      IF PLAYER=4 THEN CPUT_X=560:CPUT_Y=143:ELSE CPUT_X=565:CPUT_Y=176
  463. 4520      GOSUB *CARD.DISP
  464. 4530      'GOSUB *ERASE.LINE:COLOR 4:PRINT LP;"ﾏｲ ･････  ";
  465. 4535      IF PLAYER=4 THEN LINE(560,143)-(624,243),PSET,0,BF:CPUT_X=565:CPUT_Y=176:CARD_P=0:GOSUB *CARD.DISP
  466. 4540      IF PLAYER=4 OR MAI=1 THEN 4620
  467. 4550      IF PLAYER<>TAKO AND RND<.5! THEN IF RND<.2! THEN N=INT(RND*15) ELSE GOSUB *ERASE.LINE:PRINT"うぅ～む・・・";:GOTO 4620
  468. 4560      IF N=14 THEN GOSUB *ERASE.LINE:PRINT"げげげぇ～！　うおぉぉ！！"
  469. 4570      IF N=13 THEN IF RND<.5! THEN GOSUB *ERASE.LINE:PRINT"へへへぇーだ！"; ELSE GOSUB *ERASE.LINE:PRINT"あらまあ、きたきた！"
  470. 4580      IF N=12 THEN IF RND<.5! THEN GOSUB *ERASE.LINE:PRINT"今に見とれよぉ～　！"; ELSE GOSUB *ERASE.LINE:PRINT"おのれ～、ぶっ殺すぞ～！！"
  471. 4590      IF N<12 AND N>9 THEN IF RND<.5! THEN GOSUB *ERASE.LINE:PRINT"おっとー！  "; ELSE GOSUB *ERASE.LINE:PRINT"来てしまったぞ～！";
  472. 4600      IF N<10 AND N>4 THEN IF RND<.5! THEN GOSUB *ERASE.LINE:PRINT"んったくもうーやだなあ！！";ELSE GOSUB *ERASE.LINE:PRINT"いらねーのがきたなあ！";
  473. 4610      IF N<5 THEN GOSUB *ERASE.LINE:PRINT"あららあぁ";:IF N=0 THEN GOSUB *ERASE.LINE:PRINT "まあ、なんとかなるでしょう・・";
  474. 4620      FOR LPLP=1 TO 300:NEXT
  475. 4625      IF PLAYER=4 THEN LINE(595,270)-(619,381),PSET,0,BF
  476. 4630      X1=X
  477. 4633    NEXT LP
  478. 4634    IF PF=-2 THEN PF=0:RETURN *NAGARE
  479. 4635    IF PF=-3 THEN PF=0:RETURN *OVER.108
  480. 4639 RETURN
  481. 4640 '----------------------- 山のカードをすべて使いきったので流れる
  482. 4650 *OVER.108
  483. 4660    BEEP:GOSUB *ERASE.LINE
  484. 4665    PRINT "山のカードが無くなったので、これで流れです。";
  485. 4670    FOR LP=1 TO 10000:NEXT:GOTO *INIT.3
  486. 4680 '----------------------- 個人のカードが多すぎて流れ
  487. 4690 *NAGARE
  488. 4700    BEEP:GOSUB *ERASE.LINE:PRINT"これ以上カードは持てません。";
  489. 4705    FOR LP=1 TO 5000:NEXT
  490. 4710    BEEP:GOSUB *ERASE.LINE:PRINT"｢";P_NAME$(PLAYER);
  491. 4715    PRINT "｣のカードが２０枚を越えたので流れです。";
  492. 4720    FOR LP=1 TO 10000:NEXT:GOTO *INIT.3
  493. 4730 '----------------------- COMput@ aER PLAYER の思考ルーチン
  494. 4740 *COM.THINK
  495. 4750    'GOSUB *ERASE.LINE:PRINT"COM ｢";P.NAME$(PLAYER);"｣ ﾉ ﾊﾞﾝﾃﾞｽ !";
  496. 4760    IF WAO(PLAYER) THEN GOSUB *THINK.CARD:IF X>=0 THEN 4890
  497. 4770    IF PLAYER=TAKO THEN 4820
  498. 4780    UP=PLAYER+REVERSE:IF UP>4 THEN UP=1 ELSE IF UP<1 THEN UP=4
  499. 4790    IF WAO(UP) THEN *THINK.WAO
  500. 4800    F=-1:GOSUB *THINK.CARD:F=0:X_SUB=X
  501. 4805    IF S=14 AND RND<.2! THEN GOSUB *THINK.WDF:GOTO 4840
  502. 4810    X=X_SUB:IF X>=0 THEN 4890
  503. 4820    GOSUB *THINK.CARD:IF X>=0 THEN 4890
  504. 4830    CAN=0:IF S=14 THEN GOSUB *THINK.WDF ELSE IF S=13 THEN GOSUB *THINK.W
  505. 4840    IF CAN THEN 4890
  506. 4850    GOSUB *ERASE.LINE:COLOR 7
  507. 4855    PRINT P_NAME$(PLAYER);:
  508. 4857    PRINT " : しゃあない、１枚取るとするかあ。あ～あ・・・・";
  509. 4858    GET_C=-1:FOR WT=1 TO 1000:NEXT
  510. 4860    MAI=1:GOSUB *TDRAW.CARD:X=X1:IF N<13 AND(C=BA_C OR N=BA_N)THEN 4890
  511. 4870    IF N=13 THEN S=13:GOSUB *THINK.W:IF CAN THEN 4890
  512. 4880    GET_C=0:GOTO *NEXT.P
  513. 4890    GOSUB *ERASE.LINE:PRINT P_NAME$(PLAYER);" : ヨッシャー！　だすぞ！！";:IF GET_C THEN PRINT"出せるものをつもったぜ！";:FOR WT=1 TO 1000:NEXT
  514. 4900    CAN=X:GOSUB *PUT_CARD
  515. 4905    GOTO *NEXT.P
  516. 4910 '----------------------- 0-9,DT,RVS,S を出すかどうか
  517. 4920 *THINK.CARD
  518. 4930    K=0:S=0:MAX=0:X1=0:FOR X=1 TO KOJIN_MAX:IF M_CARD(PLAYER,X)=0 THEN 4980
  519. 4940    CARD_C=M_CARD(PLAYER,X)\100:CARD_N=M_CARD(PLAYER,X)MOD 100:IF CARD_N>12 THEN S=CARD_N:IF WAO(PLAYER) THEN IF S=14 THEN *THINK.WDF ELSE *THINK.W
  520. 4950    IF CARD_C=BA_C AND CARD_N>=MAX THEN MAX=CARD_N:X1=X:IF PLAYER=TAKO AND RND<.5! THEN X=X1:RETURN
  521. 4960    IF CARD_C=BA_C AND CARD_N=0 AND NOT F THEN RETURN
  522. 4970    IF CARD_N=BA_N AND BA_N<13 THEN RETURN
  523. 4980    NEXT:IF X1>0 THEN X=X1:RETURN
  524. 4990    X=-1:RETURN
  525. 5000 '----------------------- WDF を出すかどうか
  526. 5010 *THINK.WDF
  527. 5020    IF K(PLAYER)=2 THEN CAN=0:GOTO 5085
  528. 5030    X=0:PF=0
  529. 5035    FOR I=1 TO KOJIN_MAX
  530. 5040      IF M_CARD(PLAYER,I) MOD 100=14 THEN X=I
  531. 5050      IF M_CARD(PLAYER,I)\100=BA_C THEN PF=-1:XS=I:I=KOJIN_MAX
  532. 5060    NEXT
  533. 5065    IF PF=-1 THEN PF=0:I=XS:GOTO 5080
  534. 5070    GOSUB *THINK.COLOR:CARD_N=14:CAN=-1:GOTO 5085
  535. 5080    IF X=0 THEN ELSE IF PLAYER=TAKO OR RND<.5! THEN 5070 ELSE CAN=0
  536. 5085 RETURN
  537. 5090 '----------------------- W を出すかどうか
  538. 5100 *THINK.W
  539. 5105    PF=0
  540. 5110    IF K(PLAYER)>5 OR K(PLAYER)=2 THEN 5150
  541. 5120    FOR I=1 TO KOJIN_MAX
  542. 5125      IF M_CARD(PLAYER,I)  \  100=BA_C THEN PF=-1:XS=I:I=KOJIN_MAX:'5150
  543. 5130      IF M_CARD(PLAYER,I) MOD 100=13   THEN X=I
  544. 5140    NEXT
  545. 5142    IF PF=-1 THEN PF=0:I=XS:GOTO 5150
  546. 5145    GOSUB *THINK.COLOR:CARD_N=13:CAN=-1:RETURN
  547. 5150    CAN=0:RETURN
  548. 5160 '----------------------- W / WDF の色を何にするのかを考える
  549. 5170 *THINK.COLOR
  550. 5180    DIM K1(5)
  551. 5183    FOR I=1 TO KOJIN_MAX
  552. 5185      K1=M_CARD(PLAYER,I)\100:K1(K1)=K1(K1)+1
  553. 5188    NEXT
  554. 5190    TK_C=0:K1=0
  555. 5195    FOR I=1 TO 4
  556. 5198      IF K1(I)>K1 THEN TK_C=I:K1=K1(I)
  557. 5200    NEXT
  558. 5210    IF TK_C=BA_C OR TK_C=0 OR TK_C=5 OR (PLAYER=TAKO AND RND<.2!)THEN TK_C=INT(RND*4)+1:GOTO 5210
  559. 5220    ERASE K1
  560. 5225 RETURN
  561. 5230 '----------------------- 次の人がＵＮＯになっている時
  562. 5240 *THINK.WAO
  563. 5245    PF=0
  564. 5250    FOR X=1 TO KOJIN_MAX
  565. 5255      CARD_C=M_CARD(PLAYER,X)\ 100:CARD_N=M_CARD(PLAYER,X) MOD 100
  566. 5260      IF CARD_N=14 THEN GOSUB *THINK.COLOR:PF=-1:XS=X:X=KOJIN_MAX:GOTO 5300
  567. 5270      IF CARD_C<>BA_C THEN 5290
  568. 5280      IF CARD_N<13 AND CARD_N>9 THEN PF=-1:XS=X:X=KOJIN_MAX:GOTO 5300
  569. 5290      IF CARD_N=13 THEN GOSUB *THINK.COLOR:PF=-1:XS=X:X=KOJIN_MAX
  570. 5300    NEXT
  571. 5302    X=XS:IF PF=-1 THEN PF=0:GOTO 4890
  572. 5305 GOTO 4800
  573. 5310 '-----------------------------------------------------------
  574. 5320 '          プログラムはこれで終わりです
  575. 5350 '-----------------------------------------------------------
  576. 10000 *INIT.CARD :'*********  カードの図柄を読み込む  ***********
  577. 10010 '------------------------------------------------ Suuji Torikomi
  578. 10030   FOR IR=0 TO 7:COLOR=(IR,IR):NEXT IR
  579. 10040   LOAD @"A:UNOWAO_S.TIF"
  580. 10070 '------------------------------------------------ Hensuu Dimenjon
  581. 10080   HE=VAL(RIGHT$(TIME$,2)):RANDOMIZE HE
  582. 10090   'DIM GA%(2700)
  583. 10100 '------------------------------------------------ Blue get@ a
  584. 10110   'DIM CB%(19500)
  585. 10120   FOR GB=0 TO 630 STEP 63
  586. 10130     GET@ A(GB,0)-(GB+63,95),CB%,BG:BG=BG+2700
  587. 10140     IF BG>24300 THEN 10160 ELSE 10150
  588. 10150   NEXT GB
  589. 10160 '------------------------------------------------ Red get@ a
  590. 10170   'DIM CR%(19500)
  591. 10180   FOR GR=0 TO 630 STEP 63
  592. 10190     GET@ A(GR,95)-(GR+63,190),CR%,RG:RG=RG+2700
  593. 10200     IF RG>24300 THEN 10220 ELSE 10210
  594. 10210   NEXT GR
  595. 10220 '------------------------------------------------ Green get@ a
  596. 10230   'DIM CG%(19500)
  597. 10240   FOR GG=0 TO 630 STEP 63
  598. 10250     GET@ A(GG,190)-(GG+63,285),CG%,GGG:GGG=GGG+2700
  599. 10260     IF GGG>24300 THEN 10280 ELSE 10270
  600. 10270   NEXT GG
  601. 10280 '------------------------------------------------ Yellow get@ a
  602. 10290   'DIM CY%(19500)
  603. 10300   FOR GY=0 TO 630 STEP 63
  604. 10310     GET@ A(GY,285)-(GY+63,380),CY%,YG:YG=YG+2700
  605. 10320     IF YG>24300 THEN 10340 ELSE 10330
  606. 10330   NEXT GY
  607. 10340 '------------------------------------------------ Moji Torikomi
  608. 10350   CLS 5
  609. 10355   GOSUB *BRACK
  610. 10360   LOAD @"A:UNOWAO_M.tif"
  611. 10390 '------------------------------------------------ Draw Two get@ a
  612. 10400   GET@ A(0,  0)-(63, 95),CB%,BG:BG=BG+2700
  613. 10410   GET@ A(0, 95)-(63,190),CR%,RG:RG=RG+2700
  614. 10420   GET@ A(0,190)-(63,285),CG%,GGG:GGG=GGG+2700
  615. 10430   GET@ A(0,285)-(63,380),CY%,YG:YG=YG+2700
  616. 10440 '------------------------------------------------ Skip get@ a
  617. 10450   GET@ A(63,  0)-(126, 95),CB%,BG:BG=BG+2700
  618. 10460   GET@ A(63, 95)-(126,190),CR%,RG:RG=RG+2700
  619. 10470   GET@ A(63,190)-(126,285),CG%,GGG:GGG=GGG+2700
  620. 10480   GET@ A(63,285)-(126,380),CY%,YG:YG=YG+2700
  621. 10490 '------------------------------------------------ Reverse get@ a
  622. 10500   GET@ A(126,  0)-(189, 95),CB%,BG
  623. 10510   GET@ A(126, 95)-(189,190),CR%,RG
  624. 10520   GET@ A(126,190)-(189,285),CG%,GGG
  625. 10530   GET@ A(126,285)-(189,380),CY%,YG
  626. 10540 '------------------------------------------------ Wild Wild Draw Four get@ a
  627. 10550   'DIM CWI%(2700)
  628. 10560   FOR GWI=0 TO 399 STEP 95
  629. 10570     GET@ A(189,GWI)-(252,GWI+95),CWI%,WIG:WIG=WIG+2700
  630. 10580     IF WIG>2700 THEN 10600 ELSE 10590
  631. 10590   NEXT GWI
  632. 10600 '------------------------------------------------ Teki Card get@ a
  633. 10610   'DIM CTE%(2700)
  634. 10620   GET@ A(300,0)-(337,62),CTE%
  635. 10630 RETURN
  636. 10640 '*****************************************************************
  637. 10650 *TITLE.DISP:'*******  ゲームのタイトルを表示する  *******
  638. 10660 '------------------------------------------------ On Goto 1
  639. 10670   CLS
  640. 10680   SI=INT(RND(1)*6)+1:'IF SI=5 THEN SU=INT(RND(1)*2)+13 ELSE SU=INT(RND(1)*13)
  641. 10690   X=INT(RND(1)*570):Y=INT(RND(1)*95):CM=CM+1
  642. 10700   IF CM=50 THEN GOTO 11000 ELSE 10710
  643. 10710   ON SI GOTO *BLUE,*RED,*GREEN,*YELL,*WILD,*TEKI
  644. 10720 '------------------------------------------------ Blue put@ a
  645. 10730 *BLUE
  646. 10740   BH=INT(RND(1)*13)
  647. 10750   BLA=BH*2700
  648. 10760   PUT@ A(X,Y)-(X+63,Y+96),CB%,,,,,BLA:GOTO 10680
  649. 10770 '------------------------------------------------ Red put@ a
  650. 10780 *RED
  651. 10790   RH=INT(RND(1)*13)
  652. 10800   REA=RH*2700
  653. 10810   PUT@ A(X,Y)-(X+63,Y+96),CR%,,,,,REA:GOTO 10680
  654. 10820 '------------------------------------------------ Green put@ a
  655. 10830 *GREEN
  656. 10840   GH=INT(RND(1)*13)
  657. 10850   GEA=GH*2700
  658. 10860   PUT@ A(X,Y)-(X+63,Y+96),CG%,,,,,GEA:GOTO 10680
  659. 10870 '------------------------------------------------ Yellow put@ a
  660. 10880 *YELL
  661. 10890   YH=INT(RND(1)*13)
  662. 10895   YH=12
  663. 10900   YEA=YH*2700
  664. 10910   PUT@ A(X,Y)-(X+63,Y+96),CY%,,,,,YEA:GOTO 10680
  665. 10920 '------------------------------------------------ Wild Wild Draw Four put@ a
  666. 10930 *WILD
  667. 10940   WHE=INT(RND(1)*2)
  668. 10950   WHA=WHE*2700
  669. 10960   PUT@ A(X,Y)-(X+63,Y+96),CWI%,,,,,WHA:GOTO 10680
  670. 10970 '------------------------------------------------ Teki Card put@ a
  671. 10980 *TEKI
  672. 10990   PUT@ A(X,Y)-(X+38,Y+63),CTE%:GOTO 10680
  673. 11000 '------------------------------------------------ Gamen 1
  674. 11010   ::WIDTH 80,25
  675. 11020   LINE(11,200)-(11,315),PSET,1:LINE(11,200)-(26,200),PSET,1
  676. 11030   LINE(201,200)-(201,315),PSET,1:LINE(201,200)-(187,200),PSET,1
  677. 11040   LINE(26,200)-(26,315),PSET,1:LINE(187,200)-(187,315),PSET,1
  678. 11050   CIRCLE(106,315),94,1,.87!,0,.5!:CIRCLE(106,315),80,1,.87!,0,.5!
  679. 11060   PAINT(20,205),1,1
  680. 11070   LINE(225,200)-(225,396),PSET,2:LINE(225,200)-(240,200),PSET,2
  681. 11080   LINE(225,396)-(240,396),PSET,2:LINE(414,200)-(414,396),PSET,2
  682. 11090   LINE(414,200)-(399,200),PSET,2:LINE(414,396)-(399,396),PSET,2
  683. 11100   LINE(240,220)-(240,396),PSET,2:LINE(399,376)-(399,200),PSET,2
  684. 11110   LINE(240,200)-(399,376),PSET,2
  685. 11120   LINE(240,220)-(399,396),PSET,2:PAINT(233,210),2,2
  686. 11130   CIRCLE(532,300),97,4,1,0,1
  687. 11140   CIRCLE(532,300),83,4,1,0,1:PAINT(532,206),4,4
  688. 11150   RETURN
  689. 11300 '---------------------- 初期画面設定
  690. 11310 *MAKE.S
  691. 11320   WIDTH 80,20::CLS:LINE(0,0)-(639,399),PSET,5,B:LINE(10,10)-(450,83),PSET,5,B
  692. 11330   LINE(10,89)-(450,166),PSET,5,B:LINE(10,172)-(450,246),PSET,5,B
  693. 11340   LINE(460,10)-(629,246),PSET,5,B:LINE(10,256)-(629,389),PSET,5,B
  694. 11350   LINE(594,269)-(620,382),PSET,7,B:LINE(475,140)-(548,241),PSET,7,B
  695. 11360   LINE(36,10)-(36,83),PSET,5,,&H8888:LINE(36,92)-(36,167),PSET,5,,&H8888
  696. 11370   LINE(36,175)-(36,245),PSET,5,,&H8888:LINE(36,260)-(36,390),PSET,5,,&H8888
  697. 11380   LINE(36,280)-(486,280),PSET,5,,&H8888:PAINT(2,2),1,5
  698. 11390   COLOR 7
  699. 11400   SYMBOL(2*7.9875!,1*19.2!),"Ｃ",1,1,7:SYMBOL(2*7.9875!,2*19.2!),"Ｍ",1,1,7:SYMBOL(2*7.9875!,3*19.2!),"１",1,1,7
  700. 11410   SYMBOL(2*7.9875!,(5*19.2!)+2),"Ｃ",1,1,7:SYMBOL(2*7.9875!,(6*19.2!)+3),"Ｍ",1,1,7:SYMBOL(2*7.9875!,(7*19.2!)+5),"２",1,1,7
  701. 11420   SYMBOL(2*7.9875!,(9*19.2!)+5),"Ｃ",1,1,7:SYMBOL(2*7.9875!,(10*19.2!)+7!),"Ｍ",1,1,7:SYMBOL(2*7.9875!,(11*19.2!)+9),"３",1,1,7
  702. 11430   LOCATE  2,12:PRINT "Ｙ":LOCATE  2,13:PRINT "Ｏ":LOCATE  2,14:PRINT "Ｕ"
  703. 11440   LOCATE 75,12:PRINT "Ｕ":LOCATE 75,13:PRINT "Ｎ":LOCATE 75,14:PRINT "Ｏ"
  704. 11450   COLOR 5:LOCATE  5,11:PRINT "メッセージ：":COLOR 7:Z=1:COLOR 7
  705. 11460  'FOR G=1 TO 3:LOCATE 46,Z:PRINT "SCORE":Z=Z+2.7!:NEXT G
  706. 11461   LOCATE 46,1:PRINT "SCORE":LOCATE 46,4:PRINT "SCORE":LOCATE 46,8:PRINT "SCORE"
  707. 11463   LOCATE 65,12:PRINT "SCORE":U=1
  708. 11465   FOR G=1 TO 3:Z=-(G=1)*1-(G=2)*4-(G=3)*8:LOCATE 44,Z+1
  709. 11466     PRINT AKCNV$(RIGHT$("   "+STR$(SCORE(U)),4));"点":U=U+1
  710. 11467   NEXT G
  711. 11468   LOCATE 63,13:PRINT AKCNV$(RIGHT$("   "+STR$(SCORE(4)),4));"点"
  712. 11470  LINE(464,15)-(464,70),PSET,1:LINE(468,15)-(468,70),PSET,1:LINE(510,15)-(510,70),PSET,1
  713. 11480   LINE(514,15)-(514,70),PSET,1:LINE(464,15)-(468,15),PSET,1:LINE(510,15)-(514,15),PSET,1
  714. 11490   CIRCLE(489,70),25,1,1,0,.5!:CIRCLE(489,70),21,1,1,0,.5!
  715. 11500   PAINT(466,18),1,1
  716. 11510   LINE(519,15)-(519,94),PSET,2:LINE(519,15)-(523,15),PSET,2:LINE(569,15)-(569,94),PSET,2
  717. 11520   LINE(569,94)-(565,94),PSET,2:LINE(519,94)-(523,94),PSET,2:LINE(569,15)-(565,15),PSET,2
  718. 11530   LINE(523,94)-(523,22),PSET,2:LINE(565,15)-(565,87),PSET,2:LINE(523,22)-(565,94),PSET,2
  719. 11540   LINE(523,15)-(565,87),PSET,2
  720. 11550   PAINT(520,18),2,2:CIRCLE(599,55),26,4,1.5!,0,1
  721. 11560   CIRCLE(599,55),22,4,1.5!,0,1:PAINT(600,18),4,4
  722. 11570  RETURN
  723. 12670 *INPUT_CARD2:'----------------------------------- Card Wo Dasu(Hantei)
  724. 12680   XX=MOUSE(0):YY=MOUSE(1)
  725. 12685   IF MOUSE(2,0)=0 THEN 12680
  726. 12687   DCE=(K(4)*HA1)+(64-HA1)+40
  727. 12690   IF (MOUSE(0)>= 40 AND MOUSE(0)<=DCE) AND (MOUSE(1)>=282 AND MOUSE(1)<=377) THEN 12700 ELSE 12695
  728. 12695   IF (MOUSE(0)>=565 AND MOUSE(0)<=603) AND (MOUSE(1)>=176 AND MOUSE(1)<=239) THEN AA=0:GOTO 12720 ELSE 12696
  729. 12696   IF (MOUSE(0)>=549 AND MOUSE(0)<=620) AND (MOUSE(1)>=269 AND MOUSE(1)<=382) THEN GOSUB *UNO.SENGEN:GOTO 12680 ELSE 12680
  730. 12700   AA=INT((XX-40)/HA1)+1:IF AA<1 OR AA>K(4) THEN 12680:
  731. 12720   TAKE=AA:CARD=AA
  732. 12750 RETURN
  733. 14160 '------------------------------------------------
  734. 14165 *SENTAKU
  735. 14166   LOCATE 46,9:PRINT SPC(8):LOCATE 47,10:PRINT SPC(8)
  736. 14170   GET@ A(240,150)-(405,240),GA%
  737. 14175   LINE(240,150)-(405,240),PSET,0,BF
  738. 14180   LINE(240,150)-(405,240),PSET,7,B:LINE(241,151)-(404,239),PSET,2,BF
  739. 14190   LINE(262,200)-(312,219),PSET,7,B:LINE(263,201)-(311,218),PSET,1,BF
  740. 14200   LINE(332,200)-(384,219),PSET,7,B:LINE(333,201)-(383,218),PSET,1,BF
  741. 14205   COLOR 7
  742. 14210   SYMBOL(31*8,7*24),SENTAKU1$+"       ",1,1,7
  743. 14220   SYMBOL(33*(639/79),8*(480/20)+10),SENTAKU2$,1,1,7
  744. 14225   LOCATE 31, 8:PRINT "                          " 
  745. 14230   XX=MOUSE(0):YY=MOUSE(1):
  746. 14240   IF MOUSE(2,0)=-1 AND XX=>262 AND XX=<312 THEN 14250 ELSE 14260
  747. 14250   IF MOUSE(2,0)=-1 AND YY=>200 AND YY=<219 THEN 14350 ELSE 14260
  748. 14260   XX=MOUSE(0):YY=MOUSE(1)
  749. 14270   IF MOUSE(2,0)=-1 AND XX=>332 AND XX=<384 THEN 14280 ELSE 14230
  750. 14280   IF MOUSE(2,0)=-1 AND YY=>200 AND YY=<219 THEN 14290 ELSE 14230
  751. 14290   '
  752. 14300   LINE(333,201)-(383,218),PSET,3,BF:FOR GI=0 TO 500:NEXT GI
  753. 14310   LINE(333,201)-(383,218),PSET,1,BF:PUT@ A(240,150)-(405,240),GA%,PSET
  754. 14320   LOCATE 27, 7:PRINT SPC(30)
  755. 14330   LOCATE 33, 8:PRINT SPC(20):SEN=2
  756. 14340   GOTO 14365
  757. 14345   '
  758. 14350   LINE(263,201)-(311,218),PSET,3,BF:FOR GI=0 TO 500:NEXT GI
  759. 14360   LINE(263,201)-(311,218),PSET,1,BF:PUT@ A(240,150)-(405,240),GA%,PSET
  760. 14362   LOCATE 27, 7:PRINT SPC(30)
  761. 14363   LOCATE 33, 8:PRINT SPC(20):SEN=1
  762. 14365   LOCATE 44,8:PRINT "SCORE":LOCATE 44,9:PRINT AKCNV$(RIGHT$("   "+STR$(SCORE(3)),4));"点"
  763. 14366 RETURN
  764. 14460 '------------------------------------------------ End / Game ?
  765. 14465 *SENTAKU2
  766. 14466   SSX=SX-150:SSY=SY-150
  767. 14470   GET@ A(240+SSX,150+SSY)-(405+SSX,240+SSY),GA%
  768. 14475   LINE(240+SSX,150+SSY)-(405+SSX,240+SSY),PSET,0,BF
  769. 14480   LINE(240+SSX,150+SSY)-(405+SSX,240+SSY),PSET,7,B:LINE(241+SSX,151+SSY)-(404+SSX,239+SSY),PSET,2,BF
  770. 14490   LINE(262+SSX,200+SSY)-(312+SSX,219+SSY),PSET,7,B:LINE(263+SSX,201+SSY)-(311+SSX,218+SSY),PSET,1,BF
  771. 14500   LINE(332+SSX,200+SSY)-(384+SSX,219+SSY),PSET,7,B:LINE(333+SSX,201+SSY)-(383+SSX,218+SSY),PSET,1,BF
  772. 14505   COLOR 7
  773. 14510   SYMBOL(31*8+SSX,8*20+SSY),SENTAKU1$,1,1,7,,,1
  774. 14520   SYMBOL(33*(639/79)+SSX,8*(480/20)+10+SSY),SENTAKU2$,1,1,7,,,1
  775. 14530   XX=MOUSE(0):YY=MOUSE(1):
  776. 14540   IF MOUSE(2,0)=-1 AND XX=>262+SSX AND XX=<312+SSX THEN 14550 ELSE 14560
  777. 14550   IF MOUSE(2,0)=-1 AND YY=>200+SSY AND YY=<219+SSY THEN 14650 ELSE 14560
  778. 14560   XX=MOUSE(0):YY=MOUSE(1)
  779. 14570   IF MOUSE(2,0)=-1 AND XX=>332+SSX AND XX=<384+SSX THEN 14580 ELSE 14530
  780. 14580   IF MOUSE(2,0)=-1 AND YY=>200+SSY AND YY=<219+SSY THEN 14590 ELSE 14530
  781. 14590   '
  782. 14600   LINE(333,201)-(383,218),PSET,3,BF:FOR GI=0 TO 500:NEXT GI
  783. 14610   LINE(333,201)-(383,218),PSET,1,BF:PUT@ A(240,150)-(405,240),GA%,PSET
  784. 14630   SEN=2
  785. 14640   GOTO 14666
  786. 14645   '
  787. 14650   LINE(263+SSX,201+SSY)-(311+SSX,218+SSY),PSET,3,BF:FOR GI=0 TO 500:NEXT GI
  788. 14660   LINE(263+SSX,201+SSY)-(311+SSX,218+SSY),PSET,1,BF:PUT@ A(240+SSX,150+SSY)-(405+SSX,240+SSY),GA%,PSET
  789. 14663   SEN=1
  790. 14666 RETURN
  791. 15170 '------------------------------------------------ Wild No Iro
  792. 15175 *WILD.CO
  793. 15176   LOCATE 46,9:PRINT SPC(8):LOCATE 47,10:PRINT SPC(8)
  794. 15180   GET@ A(250,150)-(395,250),GA%
  795. 15185   LINE(250,150)-(395,240),PSET,7,B:LINE(251,151)-(394,239),PSET,2,BF
  796. 15190   LINE(269,200)-(289,220),PSET,7,B:LINE(293,200)-(313,220),PSET,7,B
  797. 15195   LINE(317,200)-(337,220),PSET,7,B:LINE(341,200)-(361,220),PSET,7,B
  798. 15200   LINE(270,201)-(288,219),PSET,1,BF:LINE(294,201)-(312,219),PSET,1,BF
  799. 15205   LINE(318,201)-(336,219),PSET,1,BF:LINE(342,201)-(360,219),PSET,1,BF
  800. 15210   SYMBOL(33*7.9875!,8*19.2!),"何色にしますか？",1,1,7
  801. 15215   SYMBOL(33*7.9875!,10*19.2!+10)," 青 赤 緑 黄",1,1,7
  802. 15216   LOCATE 44,8:PRINT "        "
  803. 15225   XX=MOUSE(0):YY=MOUSE(1)
  804. 15230   IF MOUSE(2,0)=-1 AND XX=>269 AND XX=<289 THEN 15235 ELSE 15240
  805. 15235   IF MOUSE(2,0)=-1 AND YY=>200 AND YY=<220 THEN 15288 ELSE 15240
  806. 15240   XX=MOUSE(0):YY=MOUSE(1)
  807. 15245   IF MOUSE(2,0)=-1 AND XX=>293 AND XX=<313 THEN 15250 ELSE 15255
  808. 15250   IF MOUSE(2,0)=-1 AND YY=>200 AND YY=<220 THEN 15300 ELSE 15255
  809. 15255   XX=MOUSE(0):YY=MOUSE(1)
  810. 15260   IF MOUSE(2,0)=-1 AND XX=>317 AND XX=<337 THEN 15265 ELSE 15270
  811. 15265   IF MOUSE(2,0)=-1 AND YY=>200 AND YY=<220 THEN 15315 ELSE 15270
  812. 15270   XX=MOUSE(0):YY=MOUSE(1)
  813. 15275   IF MOUSE(2,0)=-1 AND XX=>341 AND XX=<361 THEN 15280 ELSE 15225
  814. 15280   IF MOUSE(2,0)=-1 AND YY=>200 AND YY=<220 THEN 15330 ELSE 15225
  815. 15288   CARD_C=1:LINE(270,201)-(288,219),PSET,3,BF
  816. 15290     FOR G=1 TO 500:NEXT G
  817. 15292     LINE(270,201)-(288,219),PSET,1,BF:PUT@ A(250,150)-(395,250),GA%,PSET
  818. 15295     COLOR 1:LOCATE 62,5:PRINT "青色":COLOR 7:TK_C=1:GOTO 15345
  819. 15300   CARD_C=2:LINE(294,201)-(312,219),PSET,3,BF
  820. 15305     FOR G=1 TO 500:NEXT G
  821. 15307     LINE(294,201)-(312,219),PSET,1,BF:PUT@ A(250,150)-(395,250),GA%,PSET
  822. 15310     COLOR 2:LOCATE 62,5:PRINT "赤色":COLOR 7:TK_C=2:GOTO 15345
  823. 15315   CARD_C=3:LINE(318,201)-(336,219),PSET,3,BF
  824. 15320     FOR G=1 TO 500:NEXT G
  825. 15323     LINE(318,201)-(336,219),PSET,1,BF:PUT@ A(250,150)-(395,250),GA%,PSET
  826. 15325     COLOR 4:LOCATE 62,5:PRINT "緑色":COLOR 7:TK_C=3:GOTO 15345
  827. 15330   CARD_C=4:LINE(342,201)-(360,219),PSET,3,BF
  828. 15335     FOR G=1 TO 500:NEXT G
  829. 15338     LINE(342,201)-(360,219),PSET,1,BF:PUT@ A(250,150)-(395,250),GA%,PSET
  830. 15340     COLOR 6:LOCATE 62,5:PRINT "黄色":COLOR 7:TK_C=4:GOTO 15345
  831. 15345   LOCATE 33,8:PRINT SPC(16):LOCATE 33,10:PRINT SPC(16)
  832. 15360   LOCATE 46,8:PRINT "SCORE":LOCATE 44,9:PRINT AKCNV$(RIGHT$("   "+STR$(SCORE(3)),4));"点"
  833. 15363   COLOR 7
  834. 15365 RETURN
  835. 15440 '----------------------------------------------------
  836. 15450 *CARD.DISP:'----------- カードを１枚表示する
  837. 15460            'Cput@ a.X=カードの右上のＸ座標　Cput@ a.Y=カードの右上のＹ座標
  838. 15470   IF CARD_C<>5 AND CARD_N>=13 THEN 15490
  839. 15480   IF NOT CARD_P THEN GOSUB *TEKI.CARD ELSE GOSUB *JIBUN.CARD
  840. 15490 RETURN
  841. 15500 '----------------------------------------------------
  842. 15510 *TEKI.CARD
  843. 15520   PUT@ A(CPUT_X,CPUT_Y)-(CPUT_X+38,CPUT_Y+63),CTE%,PSET
  844. 15530 RETURN
  845. 15540 '----------------------------------------------------
  846. 15550 *JIBUN.CARD
  847. 15555   IF CARD_C<>5 AND CARD_N>=13 THEN 15570
  848. 15560   ON CARD_C GOSUB *CARD.B,*CARD.R,*CARD.G,*CARD.Y,*CARD.W
  849. 15570 RETURN
  850. 15580 '----------------------------------------------------
  851. 15590 *CARD.B
  852. 15600   PUT@ A(CPUT_X,CPUT_Y)-(CPUT_X+63,CPUT_Y+95),CB%,,,,,CARD_N*2700
  853. 15610 RETURN
  854. 15620 '----------------------------------------------------
  855. 15630 *CARD.R
  856. 15640   PUT@ A(CPUT_X,CPUT_Y)-(CPUT_X+63,CPUT_Y+95),CR%,,,,,CARD_N*2700
  857. 15650 RETURN
  858. 15660 '----------------------------------------------------
  859. 15670 *CARD.G
  860. 15680   PUT@ A(CPUT_X,CPUT_Y)-(CPUT_X+63,CPUT_Y+95),CG%,,,,,CARD_N*2700
  861. 15690 RETURN
  862. 15700 '----------------------------------------------------
  863. 15710 *CARD.Y
  864. 15720   PUT@ A(CPUT_X,CPUT_Y)-(CPUT_X+63,CPUT_Y+95),CY%,,,,,CARD_N*2700
  865. 15730 RETURN
  866. 15740 '----------------------------------------------------
  867. 15750 *CARD.W
  868. 15760   PUT@ A(CPUT_X,CPUT_Y)-(CPUT_X+63,CPUT_Y+95),CWI%,,,,,(CARD_N-13)*2700
  869. 15770 RETURN
  870. 15780 '----------------------------------------------------
  871. 15790 *CARD.FNC2
  872. 15800    CARD_C=CARD\100:CARD_N=CARD MOD 100:RETURN
  873. 15810 '----------------------------------------------------
  874. 15820 *SIKAKU.KAKU
  875. 15830   ON PLAYER GOSUB 15860,15870,15880,15890
  876. 15840 RETURN
  877. 15850 '----------------------- 　誰の番かを示す四角を書く
  878. 15860 XA=10:YA= 10:XB=450:YB= 83:IRO=6:GOSUB *SIKAKU:RETURN
  879. 15870 XA=10:YA= 89:XB=450:YB=166:IRO=6:GOSUB *SIKAKU:RETURN
  880. 15880 XA=10:YA=172:XB=450:YB=246:IRO=6:GOSUB *SIKAKU:RETURN
  881. 15890 XA=10:YA=256:XB=629:YB=389:IRO=6:GOSUB *SIKAKU:RETURN
  882. 15900 RETURN
  883. 15910 '----------------------------------------------------
  884. 15920 *SIKAKU
  885. 15930  LINE(XA+1,YA+1)-(XB-1,YB-1),PSET,IRO,B
  886. 15940  LINE(XA+2,YA+2)-(XB-2,YB-2),PSET,IRO,B
  887. 15950  LINE(XA+3,YA+3)-(XB-3,YB-3),PSET,IRO,B
  888. 15960  LINE(XA+4,YA+4)-(XB-4,YB-4),PSET,IRO,B
  889. 15970 RETURN
  890. 15980 '----------------------------------------------------
  891. 15990 *SIKAKU.KESU
  892. 16030   XA=10:YA= 10:XB=450:YB= 83:IRO=0:GOSUB *SIKAKU
  893. 16040   XA=10:YA= 89:XB=450:YB=166:IRO=0:GOSUB *SIKAKU
  894. 16050   XA=10:YA=172:XB=450:YB=246:IRO=0:GOSUB *SIKAKU
  895. 16060   XA=10:YA=256:XB=629:YB=389:IRO=0:GOSUB *SIKAKU
  896. 16070 RETURN
  897. 16080 '----------------------------------------------------
  898. 16090 '======================  カードをすべて並べ換える
  899. 16100 *CARD.SORT
  900. 16110   FOR I=1 TO 4:ZERO=0
  901. 16120     FOR J=1 TO K(I)+1
  902. 16130       IF M_CARD(I,J)=0 THEN ZERO=J
  903. 16140     NEXT J
  904. 16150     IF ZERO<>0 THEN SWAP M_CARD(I,K(I)+1),M_CARD(I,ZERO)
  905. 16160   NEXT I
  906. 16170   FOR D=1 TO 4
  907. 16180     SW=1:CMAX=K(D)
  908. 16190     T=1:T(T,1)=1:T(T,2)=K(D)
  909. 16200     IF T=0 THEN GOTO 16370
  910. 16210       L=T(T,1) : R=T(T,2) : T=T-1
  911. 16220       IF L>=R THEN GOTO 16350
  912. 16230       I=L : J=R : SC=M_CARD(D,(L+R)\2)
  913. 16240       IF I>J THEN GOTO 16310
  914. 16250       IF M_CARD(D,I)<SC          THEN I=I+1:GOTO 16250
  915. 16260       IF SC         <M_CARD(D,J) THEN J=J-1:GOTO 16260
  916. 16270       IF I=<J THEN GOTO 16280 ELSE GOTO 16240
  917. 16280       SWAP M_CARD(D,I),M_CARD(D,J)
  918. 16290       I=I+1 : J=J-1
  919. 16300       GOTO 16240
  920. 16310       IF I<R THEN GOTO 16320 ELSE GOTO 16330
  921. 16320       T=T+1 : T(T,1)=I : T(T,2)=R
  922. 16330       R=J
  923. 16340       GOTO 16220
  924. 16350       GOTO 16200
  925. 16360     IF I<MAX THEN 16280
  926. 16370   NEXT D
  927. 16380 RETURN
  928. 17000 '----------------------  ＵＮＯの宣言をしたときの処理
  929. 17010 *UNO.SENGEN
  930. 17015   LINE(595,270)-(619,381),PSET,2,BF:'LINE(595,270)-(619,381),0,BF
  931. 17020   IF K(4)<>2 THEN 17040
  932. 17030   'WAO(4)=-1
  933. 17032   UNO=0:FOR I=1 TO K(4)
  934. 17033     IF (M_CARD(4,I) MOD 100=BA_C) OR (M_CARD(4,I)\100) THEN UNO=UNO+1
  935. 17034     IF  M_CARD(4,I)>=13                                THEN UNO=UNO+1
  936. 17035   NEXT I
  937. 17037   IF UNO<>0 THEN WAO(4)=-1:PCMPLAY UNO4,127:GOTO 17050
  938. 17040   WAO(4)= 0:GOSUB *ERASE.LINE:PRINT "無理なことを言わないでくださいよ。"
  939. 17045   FOR PL=1 TO 1000:NEXT PL
  940. 17048   LINE(595,270)-(619,381),PSET,0,BF
  941. 17050 RETURN
  942. 17100 '----------------------  ＵＮＯの宣言をしなかったときの罰（２枚取る）
  943. 17110 *UNO.BATU
  944. 17120   GOSUB *ERASE.LINE
  945. 17125   FOR J=1 TO 10000:NEXT
  946. 17130   COLOR 2:PRINT P_NAME$(PLAYER);
  947. 17140   PRINT "はＵＮＯを言いませんでした。"
  948. 17142   FOR J=1 TO 2700:NEXT
  949. 17143   GOSUB *ERASE.LINE
  950. 17144   PRINT "罰として２枚取ってもらいます。";
  951. 17145   FOR J=1 TO 2700:NEXT
  952. 17150   COLOR 4:MAI=2:GOSUB *TDRAW.CARD:GOSUB *CARD.DRAW
  953. 17155   LINE(595,270)-(619,381),PSET,0,BF
  954. 17160 RETURN
  955. 17165 '音声デ－タ－をとりこむ
  956. 17170   *ONSEI
  957. 17180   LOAD@"A:UNO1.SND",UNO1
  958. 17190   LOAD@"A:UNO2.SND",UNO2
  959. 17200   LOAD@"A:UNO3.SND",UNO3
  960. 17210   LOAD@"A:UNO4.SND",UNO4
  961. 17220   LOAD@"A:HAKUSYU.SND",HAKUSYU
  962. 17230   LOAD@"A:BUUING.SND",BUUING
  963. 17240  RETURN
  964. 17250 'パレットを，黒に
  965. 17260 *BRACK
  966. 17270   FOR I=0 TO 15
  967. 17280    PALETTE I,[0,0,0]
  968. 17290   NEXT I
  969. 17300  RETURN
  970.